home *** CD-ROM | disk | FTP | other *** search
/ Acorn User: China / Acorn User China CD-ROM (UK) (Disc B) / Acorn User China CD-ROM (UK) (Disc B).bin / STUTTGART / FROMUTS / XLISP1 / lisp_SIMPLEPP < prev    next >
Encoding:
Text File  |  1990-02-23  |  2.7 KB  |  66 lines
  1. ;
  2. ; a pretty-printer, with hooks for the editor
  3. ;
  4.  
  5. ; First, the terminal width and things to manipulate it
  6. (setq pp$terminal-width 79)
  7.  
  8. (defmacro get-terminal-width nil
  9.   pp$terminal_width)
  10.  
  11. (defmacro set-terminal-width (new-width)
  12.   (let ((old-width pp$terminal-width))
  13.     (setq pp$terminal-width new-width)
  14.     old-width))
  15. ;
  16. ; Now, a basic, simple pretty-printer
  17. ; pp$pp prints expression, indented to indent-level, assuming that things
  18. ; have already been indented to indent-so-far. It *NEVER* leaves the cursor
  19. ; on a new line after printing expression. This is to make the recursion
  20. ; simpler. This may change in the future, in which case pp$pp could vanish.
  21. ;
  22. (defun pp$pp (expression indent-level indent-so-far)
  23. ; Step one, make sure we've indented to indent-level
  24.   (dotimes (x (- indent-level indent-so-far)) (princ " "))
  25. ; Step two, if it's an atom or it fits just print it
  26.   (cond ((or (not (consp expression))
  27.              (> (- pp$terminal-width indent-level) (flatsize expression)))
  28.          (prin1 expression))
  29. ; else, print open paren, the car, then each sub expression, then close paren
  30.         (t (princ "(")
  31.            (pp$pp (car expression) (1+ indent-level) (1+ indent-level))
  32.            (if (cadr expression)
  33.                (progn
  34.                  (if (or (consp (car expression))
  35.                          (> (/ (flatsize (car expression)) 3)
  36.                             pp$terminal-width))
  37.                      (progn (terpri)
  38.                             (pp$pp (cadr expression)
  39.                                    (1+ indent-level)
  40.                                    0))
  41.                      (pp$pp (cadr expression)
  42.                             (+ 2 indent-level (flatsize (car expression)))
  43.                             (+ 1 indent-level (flatsize (car expression)))))
  44.                  (dolist (current-expression (cddr expression))
  45.                          (terpri)
  46.                          (pp$pp current-expression
  47.                                 (+ 2 indent-level
  48.                                    (flatsize (car expression)))
  49.                                 0))))
  50.            (princ ")")))
  51.   nil)
  52. ;
  53. ; Now, the thing that outside users should call
  54. ; We have to have an interface layer to get the final terpri after pp$pp.
  55. ; This also allows hiding the second and third args to pp$pp. Said args
  56. ; being required makes the pp recursion loop run faster (don't have to map
  57. ; nil's to 0).
  58. ;       The where arg to pp is ingnored, as the obvious hack to pp$pp [adding
  59. ; an extra arg to every call to a print routine or pp$pp] doesn't work,
  60. ; printing nothing when where is nil.
  61. ;
  62. (defun pp (expression &optional where)
  63. "Print EXPRESSION on STREAM, prettily"
  64.   (pp$pp expression 0 0)
  65.   (terpri))
  66.